home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH5 / SRC / BOUNCER.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-05-02  |  4.5 KB  |  143 lines
  1. VERSION 4.00
  2. Begin VB.Form BounceForm 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00000000&
  5.    ClientHeight    =   4095
  6.    ClientLeft      =   2385
  7.    ClientTop       =   1605
  8.    ClientWidth     =   4335
  9.    ControlBox      =   0   'False
  10.    Height          =   4500
  11.    Icon            =   "BOUNCER.frx":0000
  12.    Left            =   2325
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    MousePointer    =   99  'Custom
  17.    ScaleHeight     =   273
  18.    ScaleMode       =   3  'Pixel
  19.    ScaleWidth      =   289
  20.    Top             =   1260
  21.    Width           =   4455
  22.    WindowState     =   2  'Maximized
  23. Attribute VB_Name = "BounceForm"
  24. Attribute VB_Creatable = False
  25. Attribute VB_Exposed = False
  26. Option Explicit
  27. Dim xmax As Integer
  28. Dim ymax As Integer
  29. Dim NumBalls As Integer
  30. Dim BallR() As Integer
  31. Dim BallX() As Integer
  32. Dim BallY() As Integer
  33. Dim BallDx() As Integer
  34. Dim BallDy() As Integer
  35. Dim BallClr() As Long
  36. Dim Playing As Boolean
  37. ' ************************************************
  38. ' Generate some random data.
  39. ' ************************************************
  40. Sub InitData()
  41. Dim ball As Integer
  42. Dim R As Integer
  43.     ' See how many balls there should be.
  44.     NumBalls = 20
  45.     ReDim BallR(1 To NumBalls)
  46.     ReDim BallX(1 To NumBalls)
  47.     ReDim BallY(1 To NumBalls)
  48.     ReDim BallDx(1 To NumBalls)
  49.     ReDim BallDy(1 To NumBalls)
  50.     ReDim BallClr(1 To NumBalls)
  51.     ' Set the initial ball data.
  52.     For ball = 1 To NumBalls
  53.         R = Int(20 * Rnd + 15)
  54.         BallR(ball) = R
  55.         BallX(ball) = Int((xmax - R + 1) * Rnd)
  56.         BallY(ball) = Int((ymax - R + 1) * Rnd)
  57.         BallClr(ball) = QBColor(Int(15 * Rnd) + 1)
  58.         ' Make sure it's moving at least a little.
  59.         Do
  60.             BallDx(ball) = Int(21 * Rnd - 10)
  61.             BallDy(ball) = Int(21 * Rnd - 10)
  62.         Loop While BallDx(ball) = 0 And BallDy(ball) = 0
  63.     Next ball
  64. End Sub
  65. ' ************************************************
  66. ' Play the animation.
  67. ' ************************************************
  68. Sub PlayData()
  69. Dim mpf As Long     ' Milliseconds per frame.
  70. Dim ball As Integer
  71. Dim next_time As Long
  72.     ' Set FillStyle to vbSolid.
  73.     FillStyle = vbSolid
  74.     ' Display 30 frames per second.
  75.     mpf = 1000 \ 30
  76.     ' Start the animation.
  77.     next_time = GetTickCount()
  78.     Do
  79.         ' Draw the balls.
  80.         Cls
  81.         For ball = 1 To NumBalls
  82.             FillColor = BallClr(ball)
  83.             Circle (BallX(ball), BallY(ball)), _
  84.                 BallR(ball), BallClr(ball)
  85.         Next ball
  86.             
  87.         ' Move the balls.
  88.         For ball = 1 To NumBalls
  89.             BallX(ball) = BallX(ball) + BallDx(ball)
  90.             If BallX(ball) < BallR(ball) Then
  91.                 BallX(ball) = 2 * BallR(ball) - BallX(ball)
  92.                 BallDx(ball) = -BallDx(ball)
  93.             ElseIf BallX(ball) > xmax - BallR(ball) Then
  94.                 BallX(ball) = 2 * (xmax - BallR(ball)) - BallX(ball)
  95.                 BallDx(ball) = -BallDx(ball)
  96.             End If
  97.             
  98.             BallY(ball) = BallY(ball) + BallDy(ball)
  99.             If BallY(ball) < BallR(ball) Then
  100.                 BallY(ball) = 2 * BallR(ball) - BallY(ball)
  101.                 BallDy(ball) = -BallDy(ball)
  102.             ElseIf BallY(ball) > ymax - BallR(ball) Then
  103.                 BallY(ball) = 2 * (ymax - BallR(ball)) - BallY(ball)
  104.                 BallDy(ball) = -BallDy(ball)
  105.             End If
  106.         Next ball
  107.             
  108.         ' Wait until it's time for the next frame.
  109.         next_time = next_time + mpf
  110.         WaitTill next_time
  111.     Loop
  112. End Sub
  113. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  114.     End
  115. End Sub
  116. Private Sub Form_Load()
  117.     Me.Show
  118.     InitData
  119.     PlayData
  120. End Sub
  121. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  122.     End
  123. End Sub
  124. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  125. Static times_done As Integer
  126.     times_done = times_done + 1
  127.     ' If this is one of the first couple times,
  128.     ' ignore the event.
  129.     If times_done <= 2 Then Exit Sub
  130.     ' If the mouse has not actually moved,
  131.     ' ignore the event.
  132.     If X = Screen.Width And Y = Screen.Height Then Exit Sub
  133.     ' Stop.
  134.     End
  135. End Sub
  136. Private Sub Form_Resize()
  137.     xmax = ScaleWidth - 1
  138.     ymax = ScaleHeight - 1
  139. End Sub
  140. Private Sub Form_Unload(Cancel As Integer)
  141.     End
  142. End Sub
  143.